COMMENT ⊗   VALID 00016 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00003 00002	ENTRY DUMMY
 00004 00003	α VERIFICATON DISPLAY SUBR
 00010 00004	α FAR UNDER FACE
 00011 00005	α EHIDE'S MAKE T-JOINT
 00014 00006	α ESHOW'S MAKE T-JOINT
 00017 00007	α VERTEX V HAS JUST BEEN HIDDEN UNDER FACE F
 00018 00008	SUBR EHIDE (ITG F,EDGE,V1)
 00021 00009	α CONCAVE CORNER DELAYED EHIDE ARGUMENTS
 00022 00010	α TJOYNT VSHOW CASE
 00024 00011	α VSHOW  -  MAKE CONCAVE CORNER VISIBLE
 00026 00012	α SHOW AS MUCH OF AN EDGE (WHICH HAPPENS TO BE A FOLD) AS YOU CAN
 00028 00013	α FOLD SCAN
 00030 00014	BSUBR WITHIN (ITG F,V)
 00032 00015	INTERNAL SUBR OCCULT
 00034 00016	INTERNAL SUBR KLJOTS
 00036 ENDMK
⊗;
ENTRY DUMMY;
BEGIN	"OCCULT  -  A HIDDEN LINE ELIMINATOR  -  AUGUST 1972"

REQUIRE	"PRED0.AUX[SYS,HE]"	SOURCE_FILE;


α VERIFICATON DISPLAY SUBR;

INTERNAL STRING SUBR ISTR (ITG Q); ⊂
	STRING STR; ITG SERIAL,I;
	IF Q=0 THEN RETURN("ZERO");
	IF Q=WORLD THEN RETURN("WORLD");
	IF Q=CDR(WORLD-4) THEN RETURN("CAMERA");
	I ← ITYPE(Q);
	SERIAL ← (IF I≠Q THEN CDR(Q) ELSE 0);
	IF I=1 THEN STR←NAME[PNAME(Q)] ELSE
	STR ← "UBFEV"[(I+1)FOR 1]&CVS(SERIAL);
	RETURN(STR); ⊃;

SUBR DPYE (ITG E);
BEGIN "DPYE"
	ITG V1,V2;
	REAL X1,Y1,X2,Y2;
	V1 ← PVT(E); V2 ← NVT(E);
	X1 ← XDC(V1); Y1 ← YDC(V1);
	X2 ← XDC(V2); Y2 ← YDC(V2);
	AIVECT((X1+X2)/2+VERNX,(Y1+Y2)/2+VERNY);
	DPYBIG(1);DPYSST(ISTR(E));
	DPYBRT(3);AIVECT(X1,Y1);AVECT(X2,Y2);DPYBRT(2);
END "DPYE";

SUBR DPYF (ITG F);
BEGIN "DPYF"
	REAL X0,Y0; ITG X1,Y1,X2,Y2; ITG I,E,E0,V,V1,V2;
	IF F=BGND THEN ⊂ AIVECT(0,-350);DPYSST("BGND");RETURN;⊃;
	X0←Y0←I←0;
	E0←E←PED(F);DPYBRT(3);
	DO ⊂ V←VCCW(E,F);X0←X0+XDC(V);Y0←Y0+YDC(V);INCREM(I);
	V1←PVT(E);V2←NVT(E);
	X1←XDC(V1);Y1←YDC(V1);X2←XDC(V2);Y2←YDC(V2);
	AIVECT(X1,Y1);AVECT(X2,Y2);
	E←ECCW(E,F);
	⊃ UNTIL E=E0;DPYBRT(2);
	AIVECT(X0/I,Y0/I);DPYBIG(1);DPYSST(ISTR(F));
END "DPYF";

SUBR DPYV(ITG V);
BEGIN "DPYV"
	AIVECT(XDC(V)+VERNX,YDC(V)+VERNY);
	DPYBIG(1);DPYSST(ISTR(V));
END "DPYV";
α SINGLE-STEP VERIFICATION OUTPUT;
SUBR OSTR(STRING S);
BEGIN	"OSTR"
	INTEGER CHR,ISTEP,JSTEP,BRK; STRING STR;
	INCREM(ISTEP);
	OUTSTR(CVS(ISTEP)&"."&9&S&↓);
	AIVECT(-200,450);DPYBIG(4);
	DPYSST(S);DPYOUT(3);
	IF CHR="J"∧(ISTEP<JSTEP) THEN RETURN;
	IF 0≤CHR ∧ CHR<'175 THEN
	CHR ← INCHRW ELSE CHR←INCHRS;
	IF CHR="J" THEN 
	⊂ STR←INCHWL;JSTEP←INTSCAN(STR,BRK);RETURN;⊃;
END	"OSTR";

α VERIFICATION DISPLAY;
PROCEDURE DPYALL;
BEGIN "DPYALL"
	LABEL L1,L2;
	REAL X1,Y1,X2,Y2;
	ITG B,E,V1,V2;
	EXTERNAL ITG ARRAY DPYBUF[1:1500];
	DPYSET(DPYBUF);
	B←WORLD;
L1:	B←PBODY(B);IF BTYPE(B) THEN ⊂ E←B;
L2:	E←PED(E);IF ETYPE(E) THEN ⊂
	IF VISIBLE(E)∨POTENT(E) THEN ⊂
	V1←PVT(E);V2←NVT(E);
	X1←XDC(V1);Y1←YDC(V1);X2←XDC(V2);Y2←YDC(V2);
	AIVECT(X1,Y1);AVECT(X2,Y2);⊃;
GO L2;⊃;
GO L1;⊃;
	DPYOUT(2);
END "DPYALL";

α FAR UNDER FACE;
BSUBR FARUF (ITG F,V);
BEGIN	"FARUF"
	ITG E,E0,NUF,PUF;
α TJOYNT CASE;
	IF TJ(V) THEN ⊂
	  E← (IF TJOT(V) THEN PED(TJOYNT(V)) ELSE PED(V));
	  NUF←NFACE(E); PUF←PFACE(E);
	  RETURN( POTENT(NUF) ∨ F≠PUF ); ⊃;
α NON-TJOYNT VERTEX CASE;
	E←E0←PED(V);
	DO ⊂ IF F=FCCW(E,V) THEN RETURN(FALSE);
	E←ECCW(E,V); ⊃ UNTIL E=E0;	
	RETURN(TRUE);
END "FARUF";
α EHIDE'S MAKE T-JOINT;
SUBR MKTJ1 (ITG FOLD,EDGE,V1);
BEGIN	"MKTJ1"
	ITG JUT,JOT,EJOT,EJUT,UF;
	REAL X,Y; BOOLEAN FLG;
	β !;β DPYE(FOLD);β DPYE(EDGE);β DPYV(V1);
β OSTR("MKTJ1("&ISTR(FOLD) COMMA ISTR(EDGE) COMMA ISTR(V1) RPAREN);

α T-JOINT MANDALA

		⊗ pvt
		|
		| EJOT
		|
		⊗ JOT
	   JUT	|
   nvt ⊗______⊗_|__________⊗ V1 pvt
        EDGE	|   EJUT
		|
		| FOLD
		|
		⊗ nvt
;

α SPLIT 'EM AND INSURE THAT EJUT IS UNDER;
	IF V1≠PVT(EDGE) THEN ⊂ INVERT(EDGE); FLG←TRUE ⊃;
	JUT ← ESPLIT(EDGE); TJUT.(JUT); POTEN.(JUT);
	POTEN.(EDGE);	RINGIN(EDGE,WORLD,#POTNTE);
	JOT ← ESPLIT(FOLD); TJOT.(JOT); POTEN.(JOT);
	TJOIN.(JUT,JOT); TJOIN.(JOT,JUT);
	IF FLG THEN 
	⊂ INVERT(EDGE); EJUT←PED(JUT);INVERT(EJUT); FLG←FALSE ⊃;

α SOLVE FOR LOCUS;
	CROSSING(X,Y,FOLD,EDGE);
	DACR(X,JUT+4);	DACR(X,JOT+4);
	DACR(Y,JUT+5);	DACR(Y,JOT+5);
	DACR(ZDEPTH(PFACE(EDGE),JUT),JUT+6);
	DACR(ZDEPTH(PFACE(FOLD),JOT),JOT+6);
	X←32*X/9; Y←32*Y/9; START_CODE MOVE 0,X;MOVE 1,Y;MOVE 2,JUT;
	HLLM 0,1(2);HLLM 1,2(2);MOVE 2,JOT;HLLM 0,1(2);HLLM 1,2(2);⊃;

α PRESERVE FOLDED'NESS;
	EJOT ← PED(JOT);
	FOLD.(EJOT);	RINGIN(EJOT,WORLD,#FOLDE);
	POTEN.(EJOT);	RINGIN(EJOT,WORLD,#POTNTE);

α PRESERVE VISINC'NESS ON FOLD;
	IF  VISIBLE(PVT(EJOT)) THEN RINGIN(EJOT,WORLD,#VISINC);
	IF ¬VISIBLE(NVT(FOLD)) THEN RINGO(FOLD,#VISINC);

END	"MKTJ1";
α ESHOW'S MAKE T-JOINT;
FORWARD SUBR EHIDE (ITG F,E,V);
SUBR MKTJ2 (ITG FOLD,EDGE);
BEGIN	"MKTJ2"
	ITG F,JUT,EJUT,JOT,EJOT;
	REAL X,Y;
	β !;β DPYE(FOLD);β DPYE(EDGE);
β OSTR("MKTJ2(" & ISTR(FOLD) COMMA ISTR(EDGE) RPAREN);

α SPLIT 'EM;
	JUT ← ESPLIT(EDGE);
	JOT ← ESPLIT(FOLD);
	TJOIN.(JUT,JOT); TJOIN.(JOT,JUT);

α SOLVE FOR LOCUS;
	CROSSING(X,Y,FOLD,EDGE);
	DACR(X,JUT+4);	DACR(X,JOT+4);
	DACR(Y,JUT+5);	DACR(Y,JOT+5);
	DACR(ZDEPTH(PFACE(EDGE),JUT),JUT+6);
	DACR(ZDEPTH(PFACE(FOLD),JOT),JOT+6);
	X←32*X/9; Y←32*Y/9; START_CODE MOVE 0,X;MOVE 1,Y;MOVE 2,JUT;
	HLLM 0,1(2);HLLM 1,2(2);MOVE 2,JOT;HLLM 0,1(2);HLLM 1,2(2);⊃;

α DISTINGUISH OVER AND UNDER;
	IF ZPP(JUT)>ZPP(JOT) THEN ⊂ EDGE↔FOLD;JUT↔JOT;⊃;
	EJUT ← PED(JUT); POTEN.(EJUT); RINGIN(EJUT,WORLD,#POTNTE);
	EJOT ← PED(JOT); POTEN.(EJOT); RINGIN(EJOT,WORLD,#POTNTE);
	TJUT.(JUT); POTEN.(JUT);
	TJOT.(JOT); POTEN.(JOT);

α PRESERVE FOLDED'NESS;
	IF FOLDED(EDGE) THEN
	⊂ FOLD.(EJUT); RINGIN(EJUT,WORLD,#FOLDE); ⊃;
	FOLD.(EJOT); RINGIN(EJOT,WORLD,#FOLDE);

α PRESERVE VISINC'NESS ON EDGE;
	IF FOLDED(EJUT) ∧ VISIBLE(PVT(EJUT))
	THEN RINGIN(EJUT,WORLD,#VISINC);
	IF FOLDED(EDGE) ∧ ¬VISIBLE(NVT(EDGE))
	THEN RINGO(EDGE,#VISINC);

α PRESERVE VISINC'NESS ON FOLD;
	IF  VISIBLE(PVT(EJOT)) THEN RINGIN(EJOT,WORLD,#VISINC);
	IF ¬VISIBLE(NVT(FOLD)) THEN RINGO(FOLD,#VISINC);

α HIDE HALF-EDGE;
	F ← PFACE(FOLD);
	IF QFEV(F,FOLD,NVT(EDGE))>0
	  THEN EHIDE(F,EDGE,JUT)
	  ELSE EHIDE(F,EJUT,JUT);
END	"MKTJ2";
α VERTEX V HAS JUST BEEN HIDDEN UNDER FACE F;
	FORWARD BSUBR WITHIN(ITG F,V);
SUBR VHIDE (ITG F,V);
BEGIN	"VHIDE"
	ITG E,U;
	LABEL L;
	IF ¬POTENT(V)∨¬WITHIN(F,V) THEN RETURN;
	β !;β DPYF(F);β DPYV(V);
	β OSTR("VHIDE("&ISTR(F) COMMA ISTR(V) RPAREN);

α HIDE JOT WHEN POSSIBLE;
	IF TJUT(V) THEN ⊂ U←TJOYNT(V);
	IF ZDEPTH(F,U)>ZPP(U) THEN V←U;⊃;

α CLOCK AROUND V'S EDGES;
	HIDE.(V);
L:	E ← PED(V);
	DO ⊂ IF POTENT(E) THEN ⊂ EHIDE(F,E,V);GO L ⊃;
	E ← ECCW(E,V); ⊃ UNTIL E=PED(V);

α HIDE JUT WHEN NECESSARY;
	IF TJOT(V) THEN ⊂ V←TJOYNT(V); HIDE.(V); GO L ⊃;
END "VHIDE";
SUBR EHIDE (ITG F,EDGE,V1);
BEGIN	"EHIDE"
	LABEL SOL,L1,L2,EOL;
	ITG E,E0,V2,U1,U2,V,FLG;
	REAL Q,Q1,Q2;

	IF ¬POTENT(EDGE) THEN RETURN;
	IF FTYPE(F) THEN E←E0←PED(F) ELSE
	⊂ E0←F;F←PFACE(E0);E←ECCW(E0,F);⊃;
	β !;β DPYF(F);β DPYE(EDGE);β DPYV(V1);
β OSTR("EHIDE("&ISTR(F) COMMA ISTR(EDGE) COMMA ISTR(V1) RPAREN);

α PICK'EM UP;
	FLG ← FALSE;
	V2 ← OTHER(EDGE,V1);
	V ← (IF TJ(V1) THEN TJOYNT(V1) ELSE 0);

α CLOCK AROUND OVER FACE'S EDGES A'LOOK'N FOR A CROSSING;
SOL:	U2 ← VCW(E,F); Q2 ← QEV(EDGE,U2);
L1:	U1 ← U2; U2 ← VCCW(E,F);
	Q1 ← Q2; Q2 ← QEV(EDGE,U2);

α DOWN FROM A SELF-OVERLAPPING CORNER OR T-JOINT SPECIAL CASE;
	IF V1=U1 ∨ V1=U2 THEN GO EOL;
	IF TJ(V1) ∧ (U1=V ∨ U2=V) THEN GO EOL;
α UP FROM BELOW SPECIAL CASE;
	IF V2=U2 THEN GO L2;

α TEST FOR SIDE OF EXIT CROSSING;
	IF Q1⊗Q2<0 ∧ QEV(E,V1)⊗(Q←QEV(E,V2))<0 THEN
	BEGIN	"FACE EXIT"
		F ← OTHER(E,F);
		IF ¬POTENT(F) THEN
		IF ABS(Q)≥0.01 THEN
		⊂ MKTJ1(E,EDGE,V1);β DPYALL; RETURN ⊃ ELSE GO L2;
	α EDGE LEAVES F BY CROSSING UNDER A SEAM;
		E0 ← E; E ← ECCW(E,F); GO SOL;
	END "FACE EXIT";

EOL:	E ← ECCW(E,F);
	IF E≠E0 THEN GO L1;

α EDGE NEVER LEFT F AND SO IT BE HIDDEN;
	FLG ← TRUE;
L2:	HIDE.(EDGE);
	DEFOLD(EDGE);
	β DPYALL;
	IF FLG THEN VHIDE(F,V2);
END "EHIDE";
α CONCAVE CORNER DELAYED EHIDE ARGUMENTS;
	ITG ARRAY CCARGS[1:20];
	SUBR MKVISINC (ITG UUF,EE,VV);
	IF FOLDED(EE)∧POTENT(EE) THEN
	⊂ UFACE.(UUF,EE,VV);
	  RINGIN(EE,WORLD,#VISINC);
	⊃;

α VSHOW  -  VERTEX V IS IN VIEW ABOVE FACE UF;
SUBR VSHOW (ITG UF,V);
BEGIN	"VSHOW"
	ITG F,E,E0;
	INTEGER I;
	β !;β DPYV(V);β DPYF(UF);
β OSTR("VSHOW("&ISTR(UF) COMMA ISTR(V) RPAREN);

α POTENT FOLDS OF V BECOME VISIBLE INCOMPLETE;
	VISIB.(V);
	IF ¬TJ(V) THEN
BEGIN	"REGULAR"
	I←0; E←E0←PED(V);
	DO ⊂ INCREM(I); MKVISINC(UF,E,V);
	     E←ECCW(E,V);⊃ UNTIL E=E0;
	IF I≤3 THEN RETURN; α CONVEX CORNERS EXIT HERE;
END "REGULAR";
α TJOYNT VSHOW CASE;
	IF TJ(V) THEN
BEGIN "TJ-SHOW"
	ITG JUT,JOT,E1,E2,EJUT,NUF,PUF,U;
	β OSTR("VSHOW - TJOYNT CASE.");

α PICK 'EM UP;
	JUT ← V;
	JOT ← TJOYNT(V);
	IF TJUT(JOT) THEN JUT↔JOT;
	EJUT ← PED(JUT);

α POSSIBLE JUT WIPE OUT BY JOT'S UNDERFACE;
	IF 	(V=JOT) 
	  ∧ 	UF≠PFACE(EJUT) 
	  ∧ 	UF≠NFACE(EJUT) 
	  ∧ 	ZDEPTH(UF,JUT)>ZPP(JUT)
	THEN 
	⊂ 	VHIDE(UF,JUT);
		E1←PED(JOT);
		E2←ECCW(E1,JOT);
		MKVISINC(UF,E1,JOT);
		MKVISINC(UF,E2,JOT);
		RETURN;⊃;

α VISINC'IFY EJUT - (SHOTGUN METHOD);
	VISIB.(JUT);
	E1←PED(JUT);
	E2←ECCW(E1,JUT);
	MKVISINC(UF,E1,JUT);
	MKVISINC(UF,E2,JUT);

α GET EJUT'S FACES & THE FAR UNDER FACE;
	PUF←PFACE(E1);
	NUF←NFACE(E1);
	IF ¬POTENT(NUF) THEN NUF←UF;

α VISINC'IFY EJOTS WITH THEIR PROPER FACES;
	VISIB.(JOT);
	E1←PED(JOT);
	E2←ECCW(E1,JOT);
	U ← OTHER(E1,JOT);
	IF QFEV(PUF,EJUT,U)>0 THEN E1↔E2;
	MKVISINC(NUF,E1,JOT);
	MKVISINC(PUF,E2,JOT);
END "TJ-SHOW" ELSE α CONCAVE (NEXT PAGE);
α VSHOW  -  MAKE CONCAVE CORNER VISIBLE;
α FIND UNDER FACES OF FOLDS AND DO EHIDES WHERE POSSIBLE;
BEGIN	"CONCAVE"
	ITG I,E,E0,U,S1,S2,F,F0,CUF,CNT;
	LABEL L1,L2,EOL;
	REAL Z0,Z1,Q1,Q2;
	β OSTR("VSHOW - CONCAVE JOINT CASE.");

α FOR ALL THE EDGES OF V;
	CNT←0;
	E ← E0 ← PED(V);
L1:	IF ¬POTENT(E) THEN GO EOL;
	U ← OTHER(E,V);
	Z0 ← ZPP(U);

α FOR ALL THE FACES OF V NOT BELONGING TO E;
	F0 ← FCW(E,V);
	F ← FCCW(E,V);
	S2 ← ECCW(E,V);
	Q2 ← QFEV(F,S2,U);

α GET THE SIDES OF THE FACE WHEN THE FACE IS POTENT;
L2:	F ← FCCW(S2,V);
	IF F=F0 THEN GO EOL;
	S1←S2; S2←ECCW(S2,V);
	Q1←-Q2; Q2←QFEV(F,S2,U);
	IF ¬POTENT(F) THEN GO L2;

α FACE-EDGE OVERLAP;
	IF Q1>0 ∧ Q2>0 THEN
BEGIN
	Z1 ← ZDEPTH(F,U);
	IF Z1>Z0 THEN ⊂ INCREM(CNT);CCARGS[CNT]←(F LSH 18)+E;GO EOL;⊃;
	IF ¬FOLDED(E) THEN GO L2;
	CUF ← UFACE(E,V);
	IF CUF=UF ∨ Z1>ZDEPTH(CUF,U) THEN UFACE.(F,E,V);
END;
	GO L2;
EOL:	E←ECCW(E,V);
	IF E≠E0 THEN GO L1;
	FOR I←1 THRU CNT DO
	⊂ F←CCARGS[I] LSH -18; E←CCARGS[I] LAND '777777; EHIDE(F,E,V);⊃;
END "CONCAVE";
END "VSHOW";
α SHOW AS MUCH OF AN EDGE (WHICH HAPPENS TO BE A FOLD) AS YOU CAN;
	FORWARD ISUBR FACESCAN (ITG V);
α V1 IS ALREADY VISIBLE, UF IS THE EDGE'S UNDER FACE WRT V1;
SUBR ESHOW (ITG EDGE,V1);
BEGIN	"ESHOW"
	ITG UF;
	REAL X,Y,X0,Y0,Z1,Z2;
	ITG V,V2,U1,U2,J1,J2;
	ITG FOLD,FOLD0,E,E0,NEAR,E1,E2,EUF;
	REAL Q1,Q2,R,RMIN;LABEL L;
	β !;β DPYE(EDGE);β DPYV(V1);
β OSTR("ESHOW("&ISTR(EDGE) COMMA ISTR(V1) RPAREN);
α PICK'EM UP;
	V2 ← OTHER(EDGE,V1);
	UF ← UFACE(EDGE,V1);
	IF UF=0 THEN ⊂ UF←FACESCAN(V1);UFACE.(UF,EDGE,V1);⊃;
	PED.(EDGE,V1);
	J1 ← IF TJ(V1) THEN TJOYNT(V1) ELSE V1;
	J2 ← IF TJ(V2) THEN TJOYNT(V2) ELSE V2;

α INIT FOR NEAREST EDGE SCAN;
	EUF←NEAR←EDGE;
	RMIN←9@9;
	X ← XPP(V2);
	Y ← YPP(V2);

α CHECK FOR SIDE OF EXIT FROM UNDERFACE;
	IF UF=BGND THEN GO L; α GO TO FOLDSCAN;
	E ← E0 ← PED(UF);
	U2 ← VCW(E,UF);
	Q2 ← QEV(EDGE,U2);
DO BEGIN
	U1←U2; U2←VCCW(E,UF);
	Q1←Q2; Q2←QEV(EDGE,U2);
	IF	U1≠V1 ∧ U1≠V2 ∧ U1≠J1 ∧ U1≠J2
	    ∧	U2≠V1 ∧ U2≠V2 ∧ U2≠J1 ∧ U2≠J2
	    ∧ 	Q1⊗Q2<0 
	    ∧ 	QEV(E,V2)⊗QEV(E,V1) < 0
	THEN ⊂	EUF←NEAR←E;
		CROSSING(X,Y,EDGE,E);
		RMIN←QEV(E,V1);
		DONE;⊃;
	E ← ECCW(E,UF);
END UNTIL E=E0;
α FOLD SCAN;
L:	FOLD←FOLD0←WORLD;
WHILE TRUE DO 
BEGIN "FOLDSCAN"
	FOLD ← CDR(FOLD+#FOLDE);
	IF FOLD=FOLD0 THEN DONE;

	IF 	PFACE(FOLD)≠UF
	 ∧ 	FOLD≠EDGE
	 ∧ 	(R←QEV(FOLD,V1))<0
	 ∧    	AA(FOLD)*X+BB(FOLD)*Y+CC(FOLD) > 0.01
	 ∧ 	ABS(R)<RMIN

	THEN ⊂
	 	U1←PVT(FOLD);
	 	U2←NVT(FOLD);

	IF 	QEV(EDGE,U1)⊗QEV(EDGE,U2)<0
	 ∧ 	U1≠V1 ∧ U1≠V2 ∧ U1≠J1 ∧ U2≠J2
	 ∧ 	U2≠V1 ∧ U2≠V2 ∧ U2≠J1 ∧ U2≠J2

	THEN ⊂
		CROSSING(X0,Y0,FOLD,EDGE);
		Z1 ← ZDALT (PFACE(FOLD),X0,Y0);
		Z2 ← ZDALT (UF,X0,Y0);
		IF Z2>Z1 THEN
		  ELSE ⊂
			NEAR←FOLD;
			RMIN←ABS(R);
			X←X0;
			Y←Y0 ⊃ 
	⊃ ⊃;
END "FOLDSCAN";

α MAKE A T-JOINT WHEN NECESSARY;
	IF NEAR≠EDGE THEN
	IF RMIN≥0.00 ∨ NEAR=EUF THEN
	⊂ MKTJ2(NEAR,EDGE);
	  EDGE ← PED(V1);
	  V2 ← OTHER(EDGE,V1); ⊃ ELSE
	⊂ EHIDE(NEAR,EDGE,V1);RETURN;⊃;


α MAKE THE EDGE VISIBLE AND PROMULGATE ITS UNDERFACE;
	VISIB.(EDGE);
	DEFOLD(EDGE);
	UFACE.(UF,EDGE,V2);
	IF ¬VISIBLE(V2) ∧ FARUF(UF,V2) THEN VSHOW(UF,V2);
END "ESHOW";
BSUBR WITHIN (ITG F,V);
BEGIN "WITHIN"
	ITG E,E0;
	E ← E0 ← PED(F);
	IF V=VCW(E,F) THEN RETURN(FALSE);
	DO ⊂ 
		IF V=VCCW(E,F) ∨ QFEV(F,E,V)<0 
		THEN RETURN(FALSE);
		E ← ECCW(E,F);
	⊃ UNTIL E=E0;
	RETURN(TRUE);
END "WITHIN";

ISUBR FACESCAN (ITG V);
BEGIN	"FACESCAN"
	REAL Z0,Z1,ZMAX;
	ITG F,FMAX,F0,F1,F2;
	FMAX ← BGND;
	ZMAX ← -9@9;
	Z0 ← ZPP(V);
	F1 ← F2 ← PFACE(PED(V));
	IF TJ(V) THEN F2 ← PFACE(PED(TJOYNT(V)));
	F←F0←WORLD;
WHILE TRUE DO 
BEGIN "FSCAN"
	LABEL L;
	F ← CDR(F+#POTNTF);
	IF F=F0 THEN DONE;
L:	IF F≠F1 ∧ F≠F2 ∧ WITHIN(F,V) THEN
	BEGIN
		Z1 ← ZDEPTH(F,V);
		IF Z1>Z0 THEN RETURN(F);
		IF Z1>ZMAX THEN ⊂ ZMAX←Z1; FMAX←F ⊃;
	END;
END "FSCAN";
	β !;β DPYF(FMAX);β DPYV(V);
	β OSTR("FACESCAN RETURNS FMAX = "&ISTR(FMAX));
	RETURN(FMAX);
END "FACESCAN";
INTERNAL SUBR OCCULT;
BEGIN	"OCCULT"
	ITG F,E,V;
	REAL SCALEZ;

α CREATE BACKGROUND FACE WHEN NECESSARY;
	SCALEZ←41;
	DEFINE ZCCMIN=<-100>;
	IF BGND=0 THEN ⊂
	BGND ← MKBFV;BGND ← PFACE(BGND);
	PCNT.(PCNT(WORLD)-1,WORLD); α WORLD PCNT AND POTNTF ARE SAME - SIGH;
	DACR(0,BGND-3);
	DACR(0,BGND-2);
	DACR(1,BGND-1);
	DACR(-SCALEZ/(2*ZCCMIN),BGND+4);⊃;

α MAIN SCAN;
	WHILE ¬EMPTY(WORLD,#FOLDE) DO
BEGIN
	WHILE ¬EMPTY(WORLD,#VISINC) DO
	BEGIN
		E ← CDR(WORLD+#VISINC);
		V ← PVT(E);
		IF ¬VISIBLE(V) THEN  V←NVT(E);
		ESHOW(E,V);
	END;
	IF ¬EMPTY(WORLD,#FOLDE) THEN
	BEGIN
		E ← CDR(WORLD+#FOLDE);
		V ← PVT(E); IF ¬POTENT(V) THEN V←NVT(E);
		F ← FACESCAN(V);
		IF ZDEPTH(F,V) > ZPP(V) 
		THEN VHIDE(F,V)
		ELSE VSHOW(F,V);
	END;
END;

α PROMOTE REMAINING POTENT EDGES TO VISIBLE;
α ∀ E|EεPOTNTE DO IF POTENT(E) THEN VISIB.(E);
END	"OCCULT";
INTERNAL SUBR KLJOTS;
BEGIN "KLJOTS"
	ITG B,V,VV;
	B ← WORLD;
	WHILE WORLD≠(B←PBODY(B)) DO ⊂
	V←NVT(B);
	WHILE TJ(V) DO ⊂
	VV←V; V←NVT(V);
	IF TJOT(VV) THEN KLEV(VV);⊃;⊃;
END "KLJOTS";

INTERNAL SUBR KLJUTS;
BEGIN "KLJUTS"
	ITG B,V,VV;
	B ← WORLD;
	WHILE WORLD≠(B←PBODY(B)) DO ⊂
	V←NVT(B);
	WHILE TJ(V) DO ⊂
	VV←V; V←NVT(V);
	IF TJUT(VV) THEN KLEV(VV);⊃;⊃;
END "KLJUTS";

INTERNAL SUBR KLTEMP;
BEGIN "KLTEMP"
	ITG B,E,V,EE,VV;
	B ← WORLD;
	WHILE WORLD≠(B←PBODY(B)) DO ⊂
	E←NED(B);
	WHILE E≠B DO ⊂
	EE←E;E←NED(E);IF ('100000 LAND TYPE(EE))≠0 THEN KLFE(EE);⊃;
	V←NVT(B);
	WHILE V≠B DO ⊂
	VV←V;V←NVT(V);IF ('100000 LAND TYPE(VV))≠0 THEN KLEV(VV);⊃;⊃;
END "KLTEMP";
END;